home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / modula2 / module / bierkass.mod < prev    next >
Encoding:
Text File  |  1995-11-25  |  6.2 KB  |  143 lines
  1. (******************************************************************************)
  2. (*      This MODULE is Public Domain. Copy me like a beast!                   *)
  3. (*               Christian Ledermann                                          *)
  4. (*               Wölfelkofen 2                                                *)
  5. (*               84166 Adlkofen                                               *)
  6. (******************************************************************************)
  7. (*                                                                            *)
  8. (* Started:   20.12.92     03:54:30                                           *)
  9. (* Version: 20.12.89   01:564:12:54                                           *)
  10. (*                                                                            *)
  11. (******************************************************************************)
  12. (*                                                                            *)
  13. (* Diese Software ist ohne jede Garantie. Ich verspreche                      *)
  14. (* keinerlei Wartung und übernehme keine Verantwortung für Schäden die        *)
  15. (* durch die Benutzung dieses Programmes entstehen.                           *)
  16. (* Jegliche Ersatzansprüche lehne ich ab.                                     *)
  17. (*                                                                            *)
  18. (******************************************************************************)
  19. MODULE BierKasse;
  20. (* Version*: 20.12.89   00:49*)
  21. (**************************************************************************)
  22. (*   MODULE BierKasse.                                                    *)
  23. (*   Christian Ledermann 3/93                                             *)
  24. (*                                                                        *)
  25. (*                                                                        *)
  26. (**************************************************************************)
  27. FROM SYSTEM IMPORT ADR,ADDRESS;
  28. FROM KbdEvnt IMPORT MenuSearch;
  29. FROM BierMenue IMPORT MenueEreignis,InitPreferences;
  30. FROM BlRscInc IMPORT MENUE,EDIT;
  31. FROM PreisErfassung IMPORT GetDate;
  32. FROM KassenStand IMPORT BierListeLaden;
  33. FROM EdiereBierListe IMPORT BierListe;
  34. FROM Bliste IMPORT KillList;
  35.  
  36. FROM AES IMPORT ApplInitialise,ApplExit,ResourceLoad,ResourceGetAddr,MenuBar,
  37. GrafMouse,EventMultiple,ResourceFree,ShellRead,MenuItemEnable,GrafHandle,
  38. FormDialogue;
  39. FROM GEMAESbase IMPORT Arrow,HourGlass,FormStart,FormFinish,MenuSelected,
  40.                 MesageEvent,TimerEvent,KeyboardEvent;
  41. FROM InOut IMPORT WriteString,WriteLn,WriteInt;
  42. FROM Strings IMPORT Length,RightStr;
  43.  
  44. FROM GEMVDIBase IMPORT VDIWorkInType,VDIWorkOutType;
  45. FROM VDIControls IMPORT OpenVirtualWorkstation,CloseVirtualWorkstation;
  46.  
  47.  
  48. VAR ENDE                      : BOOLEAN;
  49.     menueadresse              : ADDRESS;
  50.     id,i,j,handle             : INTEGER;
  51.     RSCfileName               : ARRAY[1..12] OF CHAR;
  52.     RetChar                   : CHAR;
  53.     OK                        : BOOLEAN;
  54.     MaxX,MaxY                 : INTEGER;
  55.     command,tail              : ARRAY[0..255] OF CHAR;
  56.     WorkIn                    : VDIWorkInType;
  57.     WorkOut                   : VDIWorkOutType;
  58.     WC,HC,WB,HB               : INTEGER;
  59.  
  60. PROCEDURE Auswahl;
  61.  
  62. VAR
  63. mBuf :ARRAY [0..7] OF INTEGER;
  64. formret,msgret : INTEGER;
  65. events,flag,mx,my,mbutton,mstate,scancode,mclicks:INTEGER;
  66. String : ARRAY [1..120] OF CHAR;
  67. BEGIN
  68. flag :=MesageEvent+TimerEvent+KeyboardEvent;
  69. REPEAT
  70.  ENDE := FALSE;
  71.  
  72.  events:=EventMultiple(flag,0,0,0,0,0,0,0,0,0,0,0,0,0,
  73.                        ADR(mBuf),10000,0,(* Timer Event*)
  74.                        mx,my,
  75.                        mbutton,mstate,scancode,mclicks);
  76. IF (events=MesageEvent)THEN
  77.      msgret :=mBuf[4];
  78.      IF mBuf[0]=MenuSelected THEN
  79.         ENDE := MenueEreignis(msgret,menueadresse);
  80.      END(*IF*);
  81.  END(*IF*);
  82.  IF (events=TimerEvent) THEN
  83.      (**********************************************************************************************************)
  84.      (*String :='[0][ TimerEvent | Nur zum Test!!!!! |  Christian   Ledermann| ver 0.0 vom 25.02.93 ][  OK  ]';*)
  85.      (*formret:=FormAlert(1,String);                                                                           *)
  86.      (**********************************************************************************************************)
  87.  END(*IF*);
  88.  IF (events=KeyboardEvent) THEN
  89.     IF ~MenuSearch(id,menueadresse,mstate,scancode,RetChar) THEN
  90.        (* Eigene Tastaturabfrage*)
  91.        IF RetChar=33C THEN (* ESC-Taste gedrückt!*)
  92.            (* Sehr praktisch wenn man mit dem Debugger arbeitet          *)
  93.            (* Im Normalfall erscheint wenn man den Debugger verlässt     *)
  94.            (* das Menü des M2Loaders. Nach einem Druck auf die ESC-Taste *)
  95.            (* ist nun das eigene Menü wieder da, ausserdem wird ein      *)
  96.            (* Redraw für den ganzen Bildschirm erzwungen                 *)
  97.  
  98.            (* Menü auschalten *)
  99.            MenuBar(menueadresse,0);
  100.            (* Hier wird ein Kommplett Redraw erzwungen ! *)
  101.            FormDialogue(FormStart,0,0,0,0,0,0,MaxX,MaxY);
  102.            FormDialogue(FormFinish,0,0,0,0,0,0,MaxX,MaxY);
  103.            (* Menü wieder einschalten *)
  104.            MenuBar(menueadresse,1);
  105.  
  106.        END(*IF*);
  107.     END(*IF*);
  108.  END(*IF*);
  109. UNTIL ENDE
  110. END Auswahl;
  111.  
  112. BEGIN
  113.     id := ApplInitialise();
  114.     RSCfileName :='BierKass.rsc';
  115.     ResourceLoad(RSCfileName);
  116.     ResourceGetAddr(0,MENUE,menueadresse);
  117.     ShellRead(ADR(command),ADR(tail));
  118.     IF Length(tail)>0 THEN
  119.          MenuItemEnable(menueadresse,EDIT,1);
  120.          RightStr(tail,12,tail,OK);
  121.          BierListeLaden(tail);
  122.     END(*IF*);
  123.     handle:=GrafHandle(WC,HC,WB,HB);
  124.     FOR j:= 0 TO 9 DO WorkIn[j]:=0 END(*FOR*);
  125.     WorkIn[10]:=2;
  126.     OpenVirtualWorkstation(WorkIn,handle,WorkOut);
  127.     MaxX:=WorkOut[0];
  128.     MaxY:=WorkOut[1];
  129.     MenuBar(menueadresse,1);
  130.     InitPreferences;
  131.     GrafMouse(Arrow,NIL);
  132.     REPEAT
  133.       OK:=GetDate();
  134.     UNTIL OK;
  135.     (*******HauptProgramm***)
  136.     Auswahl;
  137.     (*******ENDE***********)
  138.     KillList(BierListe);
  139.     ResourceFree;
  140.     CloseVirtualWorkstation(handle);
  141.     ApplExit;
  142. END BierKasse.
  143.